System Booster/System Booster.iso/Archives/HardwareProjects/VideoText.lha/VideoText4.2/source/bildschirm.p

Text File | 1995-06-26 | 17.6 KB | 571 lines

UNIT bildschirm; {$project vt }
{ Bildschirmausgaben zum Programm VideoText }

INTERFACE; FROM vt USES pagelist,decode,cct,sys;

CONST colht=15;
VAR jobcursor: Boolean;   { >Markierung in der Job- oder in der Seitenliste? }
    incomplete: Boolean;  { Seitenaufbau unterbrochen? }
    concealed: Boolean;   { verdeckte Zeichen wirklich verdeckt? }

PROCEDURE cursoroff;
PROCEDURE cursoron;
PROCEDURE mainline;
FUNCTION ja_nein: Boolean;
PROCEDURE mark_queue(really: Boolean);
PROCEDURE redraw_queue(job: Integer);
PROCEDURE space_in_queue;
FUNCTION pos_from_queue(x,y: Integer): Integer;
PROCEDURE mark_list(really: Boolean);
PROCEDURE redraw_list;
PROCEDURE update_list(start: p_onepage; delta: Integer);
FUNCTION page_from_list(x,y: Integer): p_onepage;
PROCEDURE fileinfo;
PROCEDURE test(active: Boolean);
PROCEDURE writepage(seite: p_onepage, verdeckt: Boolean);
FUNCTION number_from_page(x,y: Integer): Integer;
PROCEDURE redraw_all;
FUNCTION click_action(x,y: Integer): Char;

{ ---------------------------------------------------------------------- }

IMPLEMENTATION;

{$opt q,s+,i+ } { keine Laufzeitprüfungen außer Stack und Feldindizes }

CONST head=7; tail=6;  { Aufteilung der Warteschlange }
      sp_maxdisp=15;

VAR listoffset: Integer;
    fix1,fix2,fix3: Integer; { fileinfo-x-Positionen }

PROCEDURE cursoroff;
BEGIN
  Write(#155'0 p');  { Cursor unsichtbar }
END;

PROCEDURE cursoron;
BEGIN
  Write(#155' p');  { Cursor wieder sichtbar }
END;

PROCEDURE mainline;
BEGIN
  GotoXY(1,24); Write(#155'0m',Copy(blank40,1,39));
  GotoXY(1,24);
END;

FUNCTION ja_nein{: Boolean};
VAR ch: Char;
BEGIN
  cursoron;
  Write(' (J/N)?  ');
  REPEAT
    Delay(2); Write(#8' '#8);
    ch := waitkey;
    IF (Ord(ch) MOD 128)>31 THEN Write(ch) ELSE Write(' ');
  UNTIL ch IN ['j', 'J', 'n', 'N']
  ja_nein := ch IN ['j', 'J'];
  cursoroff;
END;

PROCEDURE mark_queue{(really: Boolean)};
{ Gibt die Position des Job-Markers <thisjob> als '>' am Bildschirm aus, }
{ <thisjob> kann Werte von <maxactive>-1 bis -<queued> annehmen. }
{ Für <really>=FALSE wird stattdessen ' ' ausgegeben. }
CONST x0=1; y0=1;
VAR y,j: Integer;
    special: Boolean;
BEGIN
  special := False;
  y := y0 + maxactive - thisjob;
  IF thisjob<0 THEN BEGIN
    y := y + 2;
    IF NOT fifo THEN y := y + 1;
    IF (queued>=colht) AND (-thisjob>head) THEN BEGIN
      { unvollständige Anzeige der Schlange }
      IF -thisjob>queued-tail THEN
        y := y + colht-1 - queued { zeigt auf hinteres Ende }
      ELSE BEGIN
        special := True;
        y := y + thisjob + head + 1; { zeigt auf die '...' }
        j := (firstinq - thisjob - 2) MOD qlen + 1;
      END;
    END;
  END;
  GotoXY(x0,y); Write(#155'0m');
  IF really THEN Write('>') ELSE Write(' ');
  IF special THEN BEGIN
    Write('(',hexstr(queue[j].pg,0),')');
  END;
END;

PROCEDURE redraw_queue{(job: Integer)};
{ Gibt für job<0 die aktuelle Belegung der Warteschlange und der aktiven Jobs }
{ am Bildschirm aus, sonst wird nur der Job mit der angegebenen Nummer neu }
{ ausgegeben: interessant ist dabei vor allem der Status der eingelesenen }
{ Unterseiten. }
CONST x0=1; y0=1;
VAR i,j,y,max: Integer;
BEGIN
  GotoXY(x0,y0); Write(#155'0m Seitensuche:');
  FOR j := 0 TO maxactive-1 DO
    IF (job<0) OR (j=job) THEN WITH activejobs[j] DO BEGIN
      GotoXY(x0,maxactive+y0-j);
      Write(Copy(blank40,1,25)); { nicht das Testfeld überschreiben! }
      GotoXY(x0+1,maxactive+y0-j);
      IF pg=0 THEN Write('---')
      ELSE BEGIN
        Write(hexstr(pg,0));
        CASE sp OF
          -3: Write('/!');
          -2: Write('/.');
          -1: Write('/*');
           0: ;
          OTHERWISE Write('/',hexstr(sp,0));
        END;
        Write('  ');
        IF sp_check[0] THEN Write('+');
        IF sp_max>0 THEN     { echte Unterseiten eingetroffen }
          IF sp<>0 THEN       { zu einer Einzelanforderung? }
            Write('+')
          ELSE BEGIN
            max := bcd(sp_max); IF max>sp_maxdisp THEN max := sp_maxdisp-2;
            Write('(');
            FOR i := 1 TO max DO
              IF sp_check[i] THEN Write('+') ELSE Write('-');
            IF bcd(sp_max)>max THEN Write('...') ELSE Write(')');
          END;
      END;
    END;
  GotoXY(x0,y0+2+maxactive); Write(' Jobs:');
  IF job<0 THEN BEGIN
    y := y0 + 3 + maxactive;
    IF fifo THEN y := y + colht - 1;
    GotoXY(x0,y); Write('         ');
    FOR j := 1 TO colht-1 DO BEGIN
      y := j+y0+2+maxactive; IF NOT fifo THEN y := y + 1;
      GotoXY(x0,y); Write('         ');
      IF j<=queued THEN BEGIN
        GotoXY(x0+1,y);
        i := (firstinq + j - 2) MOD qlen + 1;
        IF (queued>=colht) AND (j>head) THEN
          i := (firstinq + queued + j - colht - 1) MOD qlen + 1;
        IF (queued>=colht) AND (j=head+1) THEN
          Write('...')
        ELSE WITH queue[i] DO BEGIN
          Write(hexstr(pg,0));
          CASE sp OF
            -3: Write('/!');
            -2: Write('/.');
            -1: Write('/*');
             0: ;
            OTHERWISE Write('/',hexstr(sp,0));
          END;
        END;
      END;
    END; { Ende FOR-Schleife }
  END;
  IF jobcursor THEN mark_queue(True);
END;

PROCEDURE space_in_queue;
{ den für Eingaben reservierten Platz in der Warteschlange ansteuern }
CONST x0=1; y0=1;
BEGIN
  IF NOT fifo THEN
    GotoXY(x0+1,y0+3+maxactive)
  ELSE IF queued<colht THEN
    GotoXY(x0+1,queued+y0+3+maxactive)
  ELSE
    GotoXY(x0+1,colht+y0+2+maxactive);
  Write(#155'0m');
END;

FUNCTION pos_from_queue{(x,y: Integer): Integer};
{ wurde auf eine Nummer in der Warteschlange geklickt? }
CONST x0=1; y0=1;
BEGIN
  pos_from_queue := maxactive;  { unmöglicher Wert }
  IF (x<x0) OR (x>x0+8) THEN Exit;
  IF (y>y0) AND (y<=y0+maxactive) THEN
    pos_from_queue := maxactive + y0 - y { Position in der Seitensuche }
  ELSE BEGIN
    y := y - y0 - maxactive - 2; IF NOT fifo THEN Dec(y);
    IF (y>0) AND (y<colht) AND(y<=queued) THEN
      IF (queued<colht) OR (y<=head) THEN
        pos_from_queue := -y
      ELSE
        pos_from_queue := -(y-colht+queued+1);
  END;
END;

{ Der Ärger mit der Seitenliste ... }
CONST cols=3; colw=9; lspc='         '; { 9 Spaces }
      x0=10; y0=3+maxactive;

FUNCTION adjust_offset: Integer;
{ Da die Seitenliste meist nicht ganz auf den Bildschirm paßt, gibt ein }
{ Offset an, ab wo sie sichtbar ist, dieser <listoffset> wird hier neu }
{ berechnet. Der Rückgabewert sagt, um wieviele Spalten die Liste (falls }
{ bereits angezeigt) verschoben werden muß. (>0: rechts kommen Spalten dazu) }
VAR nr,delta: Integer;
    hilf: p_onepage;
BEGIN
  { Herausfinden, die wievielte Seite in der Liste <thispage> ist: }
  hilf := root; nr := 0;
  WHILE (hilf<>Nil) AND (hilf<>thispage) DO BEGIN
    hilf := hilf^.next; Inc(nr);  END;
  delta := 0;
  WHILE nr<listoffset DO BEGIN
    listoffset := listoffset-colht; Dec(delta);  END;
  WHILE nr-listoffset>=cols*colht DO BEGIN
    listoffset := listoffset+colht; Inc(delta);  END;
  adjust_offset := delta;
END;

PROCEDURE listentry(ch: Char; seite: p_onepage; nr: Integer);
{ Einen Listeneintrag erzeugen, von dem seine Nummer im sichtbaren Bereich }
{ der Liste bekannt ist. <ch> ist normalerweise '?', oder ' ', '>' um eins }
{ der beiden Zeichen zu erzwingen. }
VAR x,y: Integer;
BEGIN
  x := x0+colw*(nr DIV colht); y := y0+1+nr MOD colht;
  GotoXY(x,y);
  IF ch='?' THEN BEGIN
    Write(#155'0m',lspc); GotoXY(x,y);
    IF NOT jobcursor AND (seite=thispage) THEN ch :='>' ELSE ch := ' ';
  END;
  IF seite<>Nil THEN
    Write(ch,hexstr(seite^.pg,0),'/',hexstr(seite^.sp,0));
END;

PROCEDURE redraw_column(col: Integer);
{ gibt eine Spalte der Seitenliste aus }
VAR i: Integer;
    hilf: p_onepage;
BEGIN
  hilf := root;
  FOR i := 1 TO listoffset+(col-1)*colht DO
    IF hilf<>Nil THEN hilf := hilf^.next;
  FOR i := 1 TO colht DO BEGIN
    listentry('?',hilf,(i-1)+(col-1)*colht);
    IF hilf<>Nil THEN hilf := hilf^.next;
  END;
END;

PROCEDURE mark_list{(really: Boolean)};
{ Gibt die Position des Seiten-Markers <thispage> am Bildschirm aus, für }
{ <really>=FALSE wird die Markierung dagegen aufgehoben. }
{ Scrollt die Liste auch weiter, falls nötig. }
VAR nr,i: Integer;
    dx: Integer;
    hilf: p_onepage;
BEGIN
  { scrollen? }
  dx := adjust_offset;
  FOR i := cols DOWNTO 1 DO BEGIN
    IF dx>=i THEN  scroll_text(y0+1,y0+colht,x0,x0+cols*colw-1,0,colw);
    IF dx<=-i THEN  scroll_text(y0+1,y0+colht,x0,x0+cols*colw-1,0,-colw);
  END;
  FOR i := 1 TO cols DO
    IF (i+dx>cols) OR (i+dx<1) THEN
      redraw_column(i);
  { Herausfinden, die wievielte Seite in der Liste <thispage> ist: }
  hilf := root; nr := 0;
  WHILE (hilf<>Nil) AND (hilf<>thispage) DO BEGIN
    hilf := hilf^.next; Inc(nr);
  END;
  nr := nr-listoffset;
  IF really THEN
    listentry('>',thispage,nr) ELSE listentry(' ',thispage,nr);
END;

PROCEDURE redraw_list;
{ aktualisiert die gesamte Seitenliste }
VAR i: Integer;
    hilf: p_onepage;
BEGIN
  IF adjust_offset<>0 THEN; { Wert ist egal }
  GotoXY(x0,y0); Write(#155,'0m Im Speicher:');
  hilf := root;
  FOR i := 1 TO listoffset DO
    IF hilf<>Nil THEN hilf := hilf^.next;
  FOR i := 0 TO cols*colht-1 DO BEGIN
    listentry('?',hilf,i);
    IF hilf<>Nil THEN hilf := hilf^.next;
  END;
END;

PROCEDURE redraw_rows(rows: Integer);
{ gibt die ersten <rows> bzw. die letzten <-rows> Zeilen der Seitenliste }
{ aus, nicht ganz trivial }
VAR i,j: Integer;
    hilf: p_onepage;
BEGIN
  hilf := root;
  FOR i := 1 TO listoffset DO
    IF hilf<>Nil THEN hilf := hilf^.next;
  FOR i := 1 TO cols DO
    FOR j := 1 TO colht DO BEGIN
    IF (j<=rows) OR (j>colht+rows) THEN
      listentry('?',hilf,(j-1)+(i-1)*colht);
    IF hilf<>Nil THEN hilf := hilf^.next;
  END;
END;

PROCEDURE update_list{(start: p_onepage; delta: Integer)};
{ Es wurden Seiten in die Liste eingefügt (delta>0) bzw. entfernt (delta<0). }
{ <start> ist die erste Seite, die sich dadurch geändert hat. }
VAR i,nr: Integer;
    hilf: p_onepage;
BEGIN
  { Herausfinden, wo auf dem Bildschirm die bezeichnete Seite ist }
  hilf := root; nr := 0;
  WHILE (hilf<>Nil) AND (hilf<>start) DO BEGIN
    hilf := hilf^.next; Inc(nr);
  END;
  nr := nr-listoffset;
  { ein paar Spalten komplett scrollen, eine nur zum Teil }
  FOR i := 1 TO cols DO BEGIN
    IF (i-1)*colht>=nr THEN
      scroll_text(y0+1,y0+colht,x0+(i-1)*colw,x0+i*colw-1,-delta,0)
    ELSE IF i*colht>=nr+Abs(delta) THEN
      scroll_text(y0+1+nr MOD colht,y0+colht,x0+(i-1)*colw,x0+i*colw-1,-delta,0)
  END;
  hilf := start;
  FOR i := 0 TO delta-1 DO BEGIN
    IF (nr+i<cols*colht) AND (nr+i>=0) THEN listentry('?',hilf,nr+i);
    IF hilf<>Nil THEN hilf := hilf^.next;
  END;
  redraw_rows(delta);
  { '>' neu setzten, hat evtl. sogar den Bildschirm verlassen: }
  mark_list(NOT jobcursor);
END;

FUNCTION page_from_list{(x,y: Integer): p_onepage};
{ zu einer angeklickten Zeichenposition die Seite herausfinden }
VAR nr: Integer;
    hilf: p_onepage;
BEGIN
  page_from_list := Nil;
  IF (y IN [y0+1..y0+colht]) AND (x IN [x0-2..x0+cols*colw+2]) THEN BEGIN
    nr := listoffset + y - (y0+1) + colht*(Round((x-x0)/colw+0.5)-1);
    hilf := root;
    IF hilf<>Nil THEN
      WHILE (hilf^.next<>Nil) AND (nr>0) DO BEGIN
        hilf := hilf^.next; Dec(nr);
      END;
    IF nr=0 THEN page_from_list := hilf;
  END ELSE IF (y=y0) AND (x IN [x0..x0+12]) THEN  { Überschrift angeklickt }
    page_from_list := root;
END;

PROCEDURE fileinfo;
CONST x0=1; y0=26;
BEGIN
  GotoXY(x0,y0);
  Write(#155'0mDatei ('); fix1 := x0 + 7;
  fix2 := fix1 + 4;
  IF asciifile THEN BEGIN  Write('ASCII, '); fix2 := fix2 + 3; END
    ELSE Write('VT, ');
  fix3 := fix2 + 11;
  IF overwrite THEN BEGIN  Write('}berschr.): '); fix3 := fix3 + 1; END
    ELSE  Write('anf}gend): ');
  Write(#155'2m',outputname);
  IF withicon THEN Write(#155'0m, mit Icon');
  ClrEoL;
END;

PROCEDURE test{(active: Boolean)};
{ Decodertest, sollte aus einer Schleife heraus aufgerufen werden. }
{ für active=false wird ein leeres Testfeld erzeugt. }
CONST x0=26; y0=1;
VAR stat: Byte;
    i: Integer;
    zeit: str80;
    ch: char;
    tag,min,tic: Long;
PROCEDURE zweistellig(x: Integer);  BEGIN  Write(x DIV 10, x MOD 10);  END;
BEGIN
  GotoXY(x0,y0);
  Write(#155'0mStatus:');
  IF NOT active THEN BEGIN
    FOR stat := 1 TO 5 DO BEGIN
      GotoXY(x0,y0+stat); Write('             ');  { 13 Spaces }
    END;
    Write(#155,'2m');
  END;
  GotoXY(x0,y0+1); Write('Bus:');
  GotoXY(x0+5,y0+1); Write('AV:');
  GotoXY(x0+5,y0+2); Write('VT:');
  GotoXY(x0,y0+3); Write(' VT:');
  GotoXY(x0,y0+4); Write('Sys:');
  IF active THEN BEGIN
    Write(#155,'2m');
    stat := VTstat;
    GotoXY(x0,y0+2);
    IF i2c_status=0 THEN
      Write('OK  ') ELSE Write('Err',i2c_status);
    FOR i := 1 TO 2 DO BEGIN
      GotoXY(x0+9,y0+i);
      IF i2c_status=0 THEN
        IF (stat AND i)<>0 THEN Write('ja  ')  ELSE  Write('nein')
      ELSE
        Write('    ')
    END;
    { Zeit aus dem VT-Seitenspeicher abfragen: }
    gettime(aktspeicher,zeit);
    GotoXY(x0+5,y0+3); Write(zeit);
    { zum Vergleich: Amiga-Zeit }
    telltime(tag,min,tic);
    GotoXY(x0+5,y0+4);
    zweistellig(min DIV 60); Write(':');
    zweistellig(min MOD 60); Write(':');
    zweistellig(tic DIV 50);
  END;
  Write(#155'0m');
END;

PROCEDURE writepage{(seite: p_onepage, verdeckt: Boolean)};
{ Seite am Bildschirm ausgeben }
CONST xoff = 40;
VAR zeile,i,j,j0: Integer;
    farbe,farbe0: Word;
    out: bigstring;
    x: Byte;
    s,attrib: str80;
    dblheight,rastergfx,special: Boolean;
    normal: String[10];
BEGIN
  visblpage := seite;
  concealed := verdeckt;
  normal := #155'0;3'+colperms[7]+';4'+colperms[0]+'m'; { weiß auf schwarz }
  incomplete := True;
  dblheight := False; rastergfx := False;
  IF seite<>Nil THEN seite^.chars[0] := 2;  { Seitennummer zunächst grün }
  for i := 0 to 24 do begin
    zeile := i MOD 24;
    IF i=24 THEN BEGIN
      { 1. Zeile nochmal, mit weißer Seitennummer: }
      IF seite<>Nil THEN seite^.chars[0] := 7;
      dblheight := False;
      incomplete := False;   { Seite komplett }
    END;
    IF dblheight THEN
      { auf eine doppelthohe Zeile folgt nur eine leere Zeile }
      dblheight := False
    ELSE BEGIN
      { normale Zeile ausgeben }
      IF seite<>Nil THEN
        decode_line(seite, zeile, verdeckt, out, attrib, dblheight, rastergfx)
      ELSE
        out := blank40;
      GotoXY(xoff,zeile+1); Write(normal,out,normal,' ');
      IF rastergfx THEN BEGIN  { Zeile, die gerasterte Grafikzeichen enthält }
        special := False; farbe := 0;
        FOR j := 0 TO 39 DO BEGIN  { zu rasternde Abschnitte suchen }
          farbe0 := farbe; farbe := Ord(attrib[j+1]);
          IF (farbe<>farbe0) AND special THEN BEGIN
            raster_line(zeile+1,xoff+j0,xoff+j-1,farbe0 AND 7);
            j0 := j; special := (farbe AND 16<>0);
          END;
          IF (farbe AND 16<>0) AND NOT special THEN BEGIN
            j0 := j; special := True;
          END;
        END;
        IF special THEN
          raster_line(zeile+1,xoff+j0,xoff+39,farbe0 AND 7);
      END;
      IF zeile=23 THEN dblheight := False; { unterste Zeile nie doppelthoch! }
      IF dblheight THEN BEGIN   { Handhabung doppelthoher Zeilen }
        special := False;
        FOR j := 1 TO Length(out) DO BEGIN   { alles außer den ANSI-Codes }
          { entfernen -> erzeugt Kopie der Hintergrundfarben der Zeile }
          IF out[j] = #155 THEN special := True;
          IF NOT special THEN out[j] := ' ';
          IF out[j] = 'm' THEN special := False;
        END;
        GotoXY(xoff,zeile+2); Write(normal,out,normal,' ');
        special := False;
        FOR j := 0 TO 39 DO   { doppelthohe Abschnitte suchen }
          CASE seite^.chars[40*zeile+j] OF
            13: BEGIN j0 := j; special := True; END;
            12: IF special THEN BEGIN
                stretch_line(zeile+1,xoff+j0,xoff+j); special := False;
              END;
            OTHERWISE;
          END;
        IF special THEN
          stretch_line(zeile+1,xoff+j0,79);
      END;
    END;
    lastkey := readkey; { Taste: Abbruch und Rückmeldung ans HP }
    intui_events;
    IF (lastkey<>chr(0)) OR stop THEN
      Exit;
  END;
END;

FUNCTION number_from_page{(x,y: Integer): Integer};
{ versucht zu einer angeklickten Bildschirmposition herauszufinden, auf }
{ was für eine Nummer geklickt wurde }
VAR i,j,j0,n,m: Integer;
    ok: Boolean;
CONST xoff = 40;
BEGIN
  n := -1;
  IF (x IN [xoff..xoff+39]) AND (y IN [1..24]) AND (visblpage<>Nil) THEN BEGIN
    i := 40*(y-1);
    ok := True; j0 := x-xoff;
    FOR j := x-xoff DOWNTO 0 DO BEGIN
      IF NOT (visblpage^.chars[i+j] IN [48..57]) THEN ok := False;
      IF ok THEN j0 := j;
    END;
    ok := True; n := 0; m := 0;
    FOR j := j0 TO 39 DO BEGIN
      IF NOT (visblpage^.chars[i+j] IN [48..57]) THEN ok := False;
      IF ok THEN BEGIN
        n := (n SHL 4) + visblpage^.chars[i+j]-48; Inc(m);
      END;
    END;
    IF m=0 THEN n := -1;  { keine Ziffern gefunden }
  END;
  number_from_page := n;
END;

PROCEDURE redraw_all;
{ kompletter Neuaufbau des Bildschirms, inklusive clrscr }
BEGIN
  ClrScr;
  writepage(thispage,True); test(False);
  redraw_queue(-1); redraw_list; fileinfo;
END;

FUNCTION click_action{(x,y: Integer): Char};
{ Ein paar bestimmte Sachen, die man anklicken kann }
BEGIN
  click_action := ' ';
  IF (y=1) AND (x IN [26..32]) THEN click_action := 'T'; { "Status" }
  IF (y=1) AND (x IN [2..13]) THEN click_action := 'S'; { "Seitensuche" }
  IF (y=7) AND (x IN [2..6]) THEN click_action := 'J'; { "Jobs" }
  IF (y=26) THEN BEGIN
    IF x IN [1..fix1-3] THEN click_action := 'D'; { Dateiname }
    IF x IN [fix1..fix2-3] THEN click_action := 'F'; { Format }
    IF x IN [fix2..fix3-4] THEN click_action := 'M'; { Modus }
    IF x IN [fix3..80] THEN click_action := 'I'; { Icon? }
  END;
  IF (x>=40) THEN CASE y OF
      1..8: click_action := '-'; { oberes Seitendrittel }
      17..24: click_action := '+'; { unteres Seitendrittel }
      OTHERWISE;
    END;
END;

BEGIN { Initialisierungsteil }
  listoffset := 0;
  jobcursor := False;
  incomplete := False;
  concealed := True;
END.